#!/usr/local/bin/perl#   This is a set of ftp library routines using chat2.pl# #   Return code information taken from RFC 959#   Written by Gene Spafford  <spaf@cs.purdue.edu>#       Last update: 10 April 92,   Version 0.9## put() and port to MacPerl M. Neeracher <neeri@iis.ethz.ch>##   Most of these routines communicate over an open ftp channel#   The channel is opened with the "ftp'open" call.#package ftp;require "macchat.pl";require "GUSI.ph";#############################################################################  The following are the variables local to this package.#  I declare them all up front so I can remember what I called 'em. :-)############################################################################LOCAL_VARS: {	    $Control;    $Data_handle;    $Host;    $Myhost = "Some.Poor.Mac";# Currently no way to do gethostname    $NeedsCleanup;    $NeedsClose;    $ftp_error;    $ftp_matched;    $ftp_trans_flag;    $ftp_echo;    @ftp_list;    local(@tmp) = getservbyname("ftp", "tcp");    ($FTP = $tmp[2]) || 	die "Unable to get service number for 'ftp' (in ftplib)!\n";    @std_actions = (	    'TIMEOUT',	    q($ftp_error = "Connection timed out for $Host!\n"; undef),	    'EOF', 	    q($ftp_error = "Connection to $Host timed out unexpectedly!\n"; undef)    );    @sigs = ('INT', 'HUP', 'TERM', 'QUIT');  # sigs we'll catch & terminate on}#############################################################################  The following are intended to be the user-callable routines.#  Each of these does one of the ftp keyword functions.############################################################################sub error { ## Public    $ftp_error;}sub echo { ## Public    ($ftp_echo) = @_;}  ########################################################   cd up a directory levelsub cdup { ## Public    &do_ftp_cmd(200, "cdup");}######################################################## close an open ftp connectionsub close { ## Public    return unless $NeedsClose;    &do_ftp_cmd(221, "quit");    &macchat'close($Control);    undef $NeedsClose;    &do_ftp_signals(0);}######################################################## change remote directorysub cwd { ## Public    &do_ftp_cmd(250, "cwd", @_);}  ########################################################  delete a remote filesub delete { ## Public     &do_ftp_cmd(250, "dele", @_); }########################################################  get a directory listing of remote directory ("ls -l")sub dir { ## Public    &do_ftp_listing("list", @_);}########################################################  get a remote file to a local file#    get(remote[, local])sub get { ## Public    local($remote, $local) = @_;    ($local = $remote) unless $local;    unless (open(DFILE, ">$local")) {	$ftp_error =  "Open of local file $local failed: $!";	return undef;    } else {	$NeedsCleanup = $local;    }    return undef unless &do_open_dport; 	# Open a data channel    unless (&do_ftp_cmd(150, "retr $remote")) {	$ftp_error .= "\nFile $remote not fetched from $Host\n";	close DFILE;	unlink $local;	undef $NeedsCleanup;	return;    }    $ftp_trans_flag = 0;    do {	&macchat'expect($Data_handle, 60,		     '.|\n', q{$macchat'thisbuf =~ s|\015\012|\n|g;                               print DFILE ($macchat'thisbuf) ||			($ftp_trans_flag = 3); undef $macchat'S},		     'EOF',  '$ftp_trans_flag = 1',		     'TIMEOUT', '$ftp_trans_flag = 2');    } until $ftp_trans_flag;    close DFILE;    &macchat'close($Data_handle);		# Close the data channel    undef $NeedsCleanup;    if ($ftp_trans_flag > 1) {	unlink $local;	$ftp_error = "Unexpected " . ($ftp_trans_flag == 2 ? "timeout" :		($ftp_trans_flag != 3 ? "failure" : "local write failure")) .                " getting $remote\n";    }        &do_ftp_cmd(226);}########################################################  put a local file to a remote file#    put(local[, remote])sub put { ## Public    local($local, $remote) = @_;    ($remote = $local) unless $remote;    unless (open(DFILE, "<$local")) {	$ftp_error =  "Open of local file $local failed: $!";	return undef;    }     return undef unless &do_open_dport; 	# Open a data channel    unless (&do_ftp_cmd(150, "stor $remote")) {	$ftp_error .= "\nFile $remote not stored on $Host\n";	close DFILE;	return undef;    }    &macchat'expect($Data_handle, 0);              # Force macchat to do an accept    while (<DFILE>) {        chop;	&macchat'print($Data_handle, "$_\015\012");    }    close DFILE;    &macchat'close($Data_handle);		        # Close the data channel        &do_ftp_cmd(226);}########################################################  Do a simple name list ("ls")sub list { ## Public    &do_ftp_listing("nlst", @_);}########################################################   Make a remote directorysub mkdir { ## Public    &do_ftp_cmd(257, "mkd", @_);}########################################################  Open an ftp connection to remote hostsub open {  ## Public    if ($NeedsClose) {	$ftp_error = "Connection still open to $Host!";	return undef;    }    $Host = shift(@_);    local($Port) = $FTP;    if ($Host =~ /(.*)\s+([0-9]+)/) {	($Host, $Port) = ($1, $2);    }    local($User, $Password, $Acct) = @_;    $User = "anonymous" unless $User;    $Password = "-" . $main'ENV{'USER'} . "@$Myhost" unless $Password;    $ftp_error = '';    unless($Control =     	&macchat'open_port(		&GUSI'AF_INET, &GUSI'pack_sockaddr_in(&GUSI'AF_INET, $Host, $Port))) {	$ftp_error = "Unable to connect to $Host";	if ($Port == $FTP) {	    $ftp_error .= " ftp port: $!";	} else {	    $ftp_error .= " port $Port: $!";	}	return undef;    }    unless(&macchat'expect($Control, 60,		        '^220 .*\015\012',	"1",		        '^\d\d\d .*\015\012',  	"undef")) {	$ftp_error = "Error establishing control connection to $Host";        &macchat'close($Control);	return undef;    }    &do_ftp_signals($NeedsClose = 1);    unless (&do_ftp_cmd(331, "user $User")) {	$ftp_error .= "\nUser command failed establishing connection to $Host";	return undef;    }    unless (&do_ftp_cmd("(230|332|202)", "pass $Password")) {	$ftp_error .= "\nPassword command failed establishing connection to $Host";	return undef;    }    return 1 unless $Acct;    unless (&do_ftp_cmd("(230|202)", "pass $Password")) {	$ftp_error .= "\nAcct command failed establishing connection to $Host";	return undef;    }    1;}########################################################  Get name of current remote directorysub pwd { ## Public    if (&do_ftp_cmd(257, "pwd")) {	$ftp_matched =~ m/^257 (.+)\015?\012/;	$1;    } else {	undef;    }    }########################################################  Rename a remote filesub rename { ## Public    local($from, $to) = @_;    &do_ftp_cmd(350, "rnfr $from") && &do_ftp_cmd(250, "rnto $to");}########################################################  Set transfer typesub type { ## Public    &do_ftp_cmd(200, "type", @_); }#############################################################################  The following are intended to be utility routines used only locally.#  Users should not call these directly.############################################################################sub do_ftp_cmd {  ## Private    local($okay, @commands, $val) = @_;    $ftp_echo && $commands[0] && 	print STDERR join(" ", @commands) . "\015\012";    $commands[0] && 	&macchat'print($Control, (join(" ", @commands) . "\015\012"));    &macchat'expect($Control, 60, 		 "^$okay .*\\015\\012",    'print STDERR $& if $ftp_echo;                     $ftp_matched = $&; 1',		 "^(\d)\d\d .*\\015\\012", '($String = $&) =~ y/\015\012//d;                     print STDERR $& if $ftp_echo;		     $ftp_error = qq{Unexpected reply for ' .		     "@commands" . ': $String}; 		     $1 > 3 ? undef : 1',		 @std_actions		);}#######################################################sub do_ftp_listing { ## Private    local(@lcmd) = @_;    @ftp_list = ();    $ftp_trans_flag = 0;    return undef unless &do_open_dport;    return undef unless &do_ftp_cmd(150, @lcmd);    do {			#  Following is grotty, but macchat2 makes us do it        &macchat'expect($Data_handle, 30,		'(.*\n?\012)',    'push(@ftp_list, $1)',		"EOF",     '$ftp_trans_flag = 1');    } until $ftp_trans_flag;    &macchat'close($Data_handle);    return undef unless &do_ftp_cmd(226);    grep(y/\015\012//d, @ftp_list);    @ftp_list;}  #######################################################sub do_open_dport { ## Private    local(@foo, $fam, $addr, $port) = &macchat'open_listen(&GUSI'AF_INET);    ($port, $Data_handle) = @foo;    ($fam,$addr,$port) = &GUSI'unpack_sockaddr_in($port);    unless ($Data_handle) {	$ftp_error =  "Unable to open data port: $!";	return undef;    }    $addr =~ tr/./,/;    @foo = ($port >> 8, $port & 0xff);    $addr .= "," . join(',', @foo);        &do_ftp_cmd(200, "port $addr");}#########################################################  To cleanup after a problem#sub do_ftp_abort {    die unless $NeedsClose;    &macchat'print($Control, "abor", "\015\012");    &macchat'close($Data_handle);    &macchat'expect($Control, 10, '.', undef);    &macchat'close($Control);    close DFILE;    unlink($NeedsCleanup) if $NeedsCleanup;    die;}#########################################################  To set signals to do the abort properly#sub do_ftp_signals {    local($flag, $sig) = @_;    local ($old, $new) = ('DEFAULT', "ftp'do_ftp_abort");    $flag || (($old, $new) = ($new, $old));    foreach $sig (@sigs) {	($SIG{$sig} == $old) && ($SIG{$sig} = $new);    }}1;